{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  WumpusLite.PostScript
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- PostScript syntax
--
--------------------------------------------------------------------------------

module WumpusLite.PostScript
  (


  ) where

import WumpusLite.Colour
import WumpusLite.Geometry
import WumpusLite.GraphicProps
import WumpusLite.PostScriptDoc
import WumpusLite.Utils.FormatCombinators

newtype VarId = VarId { getVarId :: String }
  deriving (Eq,Ord,Show)

data PsProc = PSProc 
    { proc_name :: String
    , proc_args :: VarId
    , proc_body :: [PsSkel]
    }
  deriving (Eq,Show)

type FontName = String

--
-- Quandary - PostScript can easily accommodate rudimentary 
-- expressions but SVG can\'t and expressions significantly 
-- increase expressiveness. E.g. drawing a size parametric 
-- square with paths is difficult without negation. 
-- 
-- Do we add expressions with the intention of using inline 
-- expansion to eliminate them in SVG? This will massively 
-- increase code size...
-- 
-- Yes - the prime /web/ output should be Canvas plus JavaScript.
--





data PsSkel = PsPath PathSkel
            | PsText
  deriving (Eq,Show)            

data Value = Var    VarId
           | Float  Decimal
           | Char   String
           | String String
  deriving (Eq,Show)

type ValVec2 = Vec2 Value


-- | The stk (stroke / stack) colour is a /difference/ to the 
-- graphics state.
--
data PathSkel = PathSkel 
    { path_colour_delta :: Maybe RGBi           -- Stroke (fill always delta)
    , path_stroke_delta :: StrokeDelta
    , path_ana          :: Maybe ValVec2
    , path_segs         :: [PathCmd]            -- may have vars or decimals 
    , path_draw         :: DrawStyle
    }
  deriving (Eq,Show)
  
data StrokeDelta = StrokeDelta
    { delta_line_width  :: Maybe Decimal
    , delta_line_cap    :: Maybe LineCap
    , delta_line_join   :: Maybe LineJoin
    , delta_dash_patn   :: Maybe DashPattern
    }
  deriving (Eq,Show)


data PathCmd = RLineTo  Value Value
             | RCurveTo Value Value Value Value Value Value
  deriving (Eq,Show)



data DrawStyle = OSTROKE | CSTROKE | CFILL RGBi | CFILL_STROKE RGBi
  deriving (Eq,Ord,Show)


output_path :: PathSkel -> Doc
output_path skel = 
          command "newpath" []
    $+$   originMove (path_ana skel)
    $+$   vcat (map ppPathCmd $ path_segs skel)
                     

-- Grrr - need syntatic vectors - parameterized on Var or Num...


-- | If Vec then @pVMOVETO@ else @moveto@.
--
originMove :: Maybe ValVec2 -> Doc
originMove Nothing            = command "moveto" [ ppVar "X", ppVar "Y" ]
originMove (Just (V2 dx dy))  = 
    command "pVMOVETO" [ppVar "X", ppVar "Y", ppVal dx, ppVal dy]


ppPathCmd :: PathCmd -> Doc
ppPathCmd (RLineTo x1 y1)               = 
    command "rlineto" [ ppVal x1, ppVal y1 ]

ppPathCmd (RCurveTo x1 y1 x2 y2 x3 y3)  =
    command "rcurveto" [ ppVal x1, ppVal y1, ppVal x2, ppVal y2
                       , ppVal x3, ppVal y3 ]


ppVar :: String -> Doc
ppVar = text

ppVal :: Value -> Doc
ppVal (Var v)       = ppVar (getVarId v)
ppVal (Char name)   = text $ '/' : name
ppVal (Float d)     = dtruncFmt d
ppVal (String s)    = parens (text s)

